00100	(DE COMPAC (E AC) (COND ((ATOM E) (LIST (LIST 
00200	@MOVE AC (COND ((NUMBERP E) (LIST @QUOTE E))
00300	(T (LIST @SPECIAL E))))))
00400	((EQ (CAR E) @PLUS) (APPEND (COMPAC (CADR E) AC)
00500	(COMPLUS (CDDR E) AC)))
00600	((EQ (CAR E) @TIMES) (APPEND (COMPAC (CADR E) AC)
00700	(COMTIMES (CDDR E) AC)))))
00800	
00900	(DE COMPLUS (U AC) (COND ((NULL U) NIL) ((ATOM (CAR U))
01000	(CONS 
01100	(LIST @FADR AC (LIST (COND ((NUMBERP (CAR U)) @QUOTE)
01200	(T @SPECIAL)) (CAR U))) (COMPLUS (CDR U) AC)))
01300	(T (APPEND (COMPAC (CAR U) (ADD1 AC))
01400	(CONS (LIST @FADR AC (ADD1 AC)) (COMPLUS (CDR U) AC))))))
01500	
01600	(DE COMTIMES (U AC) (COND ((NULL U) NIL) ((ATOM (CAR U))
01700	(CONS 
01800	(LIST @FMPR AC (LIST (COND ((NUMBERP (CAR U)) @QUOTE)
01900	(T @SPECIAL)) (CAR U))) (COMTIMES (CDR U) AC)))
02000	(T (APPEND (COMPAC (CAR U) (ADD1 AC))
02100	(CONS (LIST @FMPR AC (ADD1 AC)) (COMTIMES (CDR U) AC))))))
02200	(DE MERGE (U V) (COND ((NULL U) V) ((NULL V) U)
02300	((LESSP (CAAR V) (CAAR U)) (CONS (CAR U)
02400	(MERGE (CDR U) V))) (T (CONS (CAR V) (MERGE U(CDR V))))))
02500	
02600	(DE SORT (U) (SORTA U NIL))
02700	
02800	(DE SORTA (U V) (COND ((NULL U) (SORTB NIL V))
02900	(T (SORTA (CDR U) (SORTC (LIST (CAR U)) V)))))
03000	
03100	(DE SORTC (U V) (COND ((NULL V) (LIST U))
03200	((NULL (CAR V)) (CONS U (CDR V)))
03300	(T (CONS NIL (SORTC (MERGE U (CAR V)) (CDR V))))))
03400	
03500	(DE SORTB (U V) (COND ((NULL V) U)
03600	(T (SORTB (MERGE U (CAR V)) (CDR V)))))
03700	
03800	(DE ARRANGE (E) (COND ((ATOM E) (CONS 0 E))
03900	(T ((LAMBDA (Z) 
04000	((LAMBDA (W) (CONS (MAX (CAAR Z) W) (CONS W (CONS (CAR E) Z))))
04100	(ADD1 (CAADR Z))))
04200	(SORT (MAPCAR (FUNCTION ARRANGE) (CDR E)))))))
04300